home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / PowerMacOberon 1.2 / Source / Tools / CrazyFiller.Mod (.txt) < prev    next >
Oberon Text  |  1995-08-22  |  16KB  |  348 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. StampElems
  5. Alloc
  6. 7 Feb 95
  7. 7 Feb 95
  8. FoldElems
  9. Syntax10.Scn.Fnt
  10. redraw
  11. Syntax10.Scn.Fnt
  12. define new zooming area
  13. Syntax10.Scn.Fnt
  14. restore to full size
  15. MODULE CrazyFiller;    (* Christoph Steindl (CS) 02.02.95 - 
  16. "Title": CrazyFiller
  17. "Author": Christoph Steindl (CS)
  18. "Abstract": Implements a new handler for the filler viewers. Filler viewers are dummy viewers which are
  19.     visible if no other viewers are on the screen (as well in the user track as in the system track). Then the 
  20.     filler viewers are painted with Mandlebrot sets. You can zoom into the figures selecting a rectangular 
  21.     area with the left mouse. You can restore the initial figure by pressing the setup button.
  22. "Keywords": filler
  23. "Version": 1.0
  24. "From":  02.02.95 16:26:50
  25. "Until": 
  26. "Changes": no changes
  27. "Hints": Use System.Open CrazyFiller.Tool
  28. IMPORT Display, Viewers, Oberon, In, Out, Input;
  29. CONST 
  30.     ML = 2; MM = 1; MR = 0; (* mouse keys *)
  31.     filler = 1;
  32.     bound = 10;
  33.     CrazyFiller* = POINTER TO CrazyFillerDesc;
  34.     Drawer* = POINTER TO DrawerDesc;
  35.     Region* = POINTER TO RegionDesc;
  36.     DrawerDesc* = RECORD (Oberon.TaskDesc)
  37.         filler: CrazyFiller;
  38.         dx, dy: LONGREAL;
  39.     END;
  40.     CrazyFillerDesc* = RECORD;
  41.         vwr: Viewers.Viewer;
  42.         regions: Region;
  43.         drawer: Drawer;
  44.         xMin, xMax, yMin, yMax: LONGREAL
  45.     END;
  46.     RegionDesc* = RECORD
  47.         x, y, w, h: INTEGER;
  48.         next: Region
  49.     END;
  50.     fillerHandler: Display.Handler;
  51.     userFiller, systemFiller: CrazyFiller;
  52.     maxIter*: INTEGER;
  53.     regsPerCycle*: INTEGER;
  54. PROCEDURE Min(x, y: INTEGER): INTEGER;
  55. BEGIN
  56.     IF x < y THEN RETURN x ELSE RETURN y END
  57. END Min;
  58. PROCEDURE Max(x, y: INTEGER): INTEGER;
  59. BEGIN
  60.     IF x > y THEN RETURN x ELSE RETURN y END
  61. END Max;
  62. PROCEDURE DrawMandelbrodt;
  63.     VAR this: Drawer; p, q, h1, h2, x, y, x0, y0: LONGREAL; filler: CrazyFiller;
  64.         region: Region; k1, k2, k3, k4, k5, i, j, count: INTEGER; allBlack: BOOLEAN;
  65.     PROCEDURE Dot (col, x, y: INTEGER);
  66.     BEGIN
  67.         IF col = maxIter THEN
  68.             Display.ReplConst(Display.white, x, y, 1, 1, Display.replace)
  69.         ELSE
  70.             Display.ReplConst(col MOD 15, x, y, 1, 1, Display.replace)
  71.         END
  72.     END Dot;
  73.     PROCEDURE Eval (i, j: INTEGER; VAR k: INTEGER);
  74.     BEGIN
  75.         k := 0; x := 0; y := 0;
  76.         p := filler.xMin + (i - filler.vwr.X) * this.dx; q := filler.yMin + (j - filler.vwr.Y) * this.dy;
  77.         REPEAT
  78.             h1 := x * x; h2 := y * y;
  79.             x0 := h1 - h2 + p; y0 := 2 * x * y + q;
  80.             x := x0; y := y0; INC(k)
  81.         UNTIL (k >= maxIter) OR (h1 + h2 > bound);
  82.     END Eval;
  83.     PROCEDURE Divide (x, y, w, h: INTEGER; VAR regions: Region);
  84.         VAR xHalf, yHalf: INTEGER; tmp: Region;
  85.     BEGIN
  86.         xHalf := w DIV 2; yHalf := h DIV 2;
  87.         IF xHalf # 0 THEN
  88.             IF yHalf # 0 THEN
  89.                 NEW(tmp); tmp.x := x; tmp.y := y; tmp.w := xHalf; tmp.h := yHalf; 
  90.                 tmp.next := regions; regions := tmp; 
  91.                 NEW(tmp); tmp.x := x + xHalf; tmp.y := y; tmp.w := w - xHalf; tmp.h := yHalf;
  92.                 tmp.next := regions; regions := tmp;
  93.                 NEW(tmp); tmp.x := x; tmp.y := y + yHalf; tmp.w := xHalf; tmp.h := h - yHalf;
  94.                 tmp.next := regions; regions := tmp;
  95.                 NEW(tmp); tmp.x := x + xHalf; tmp.y := y + yHalf; tmp.w := w - xHalf; tmp.h := h - yHalf;
  96.                 tmp.next := regions; regions := tmp;
  97.             ELSE
  98.                 NEW(tmp); tmp.x := x; tmp.y := y; tmp.w := xHalf; tmp.h := 1; 
  99.                 tmp.next := regions; regions := tmp;
  100.                 NEW(tmp); tmp.x := x + xHalf; tmp.y := y; tmp.w := w - xHalf; tmp.h := 1;
  101.                 tmp.next := regions; regions := tmp;
  102.             END
  103.         ELSE
  104.             IF yHalf # 0 THEN
  105.                 NEW(tmp); tmp.x := x; tmp.y := y; tmp.w := 1; tmp.h := yHalf; 
  106.                 tmp.next := regions; regions := tmp;
  107.                 NEW(tmp); tmp.x := x; tmp.y := y + yHalf; tmp.w := 1; tmp.h := h - yHalf;
  108.                 tmp.next := regions; regions := tmp;
  109.             ELSE
  110.                 Eval(x, y, xHalf);
  111.                 Dot(xHalf, x, y)
  112.             END
  113.         END
  114.     END Divide;
  115. BEGIN
  116.     this := Oberon.CurTask(Drawer); filler := this.filler;
  117.     region := filler.regions; filler.regions := filler.regions.next;
  118.     count := regsPerCycle;
  119.     WHILE (count > 0) & (region # NIL) DO
  120.         Eval(region.x, region.y, k1); Eval(region.x + region.w - 1, region.y, k2);
  121.         Eval(region.x, region.y + region.h - 1, k3); Eval(region.x + region.w - 1, region.y + region.h - 1, k4);
  122.         Dot(k1, region.x, region.y); Dot(k2, region.x + region.w - 1, region.y);
  123.         Dot(k3, region.x, region.y + region.h - 1); Dot(k4, region.x + region.w - 1, region.y + region.h - 1);
  124.         allBlack := (k1 = k2) & (k2 = k3) & (k3 = k4);
  125.         FOR i := region.x + 1 TO region.x + region.w - 2 DO
  126.             Eval(i, region.y, k5); Dot(k5, i, region.y); allBlack := allBlack & (k5 = k1);
  127.             Eval(i, region.y + region.h - 1, k5); Dot(k5, i, region.y + region.h - 1); allBlack := allBlack & (k5 = k1)
  128.         END;
  129.         FOR j := region.y + 1 TO region.y + region.h - 2 DO
  130.             Eval(region.x, j, k5); Dot(k5, region.x, j); allBlack := allBlack & (k5 = k1);
  131.             Eval(region.x + region.w - 1, j, k5); Dot(k5, region.x + region.w - 1, j); allBlack := allBlack & (k5 = k1)
  132.         END;
  133.         IF allBlack & (region.w > 2) & (region.h > 2) THEN
  134.             IF k1 = maxIter THEN
  135.                 Display.ReplConst(Display.white, region.x + 1, region.y + 1, region.w - 2, region.h - 2, Display.replace)
  136.             ELSE
  137.                 Display.ReplConst(k1 MOD 15, region.x + 1, region.y + 1, region.w - 2, region.h - 2, Display.replace)
  138.             END
  139.         ELSIF (region.w > 2) & (region.h > 2) THEN
  140.             Divide(region.x + 1, region.y + 1, region.w - 2, region.h - 2, filler.regions);
  141.         END;
  142.         DEC(count); region := filler.regions; 
  143.         IF (filler.regions # NIL) & (count > 0) THEN filler.regions := filler.regions.next END
  144.     END;
  145.     IF region = NIL THEN Oberon.Remove(this) END
  146. END DrawMandelbrodt;
  147. PROCEDURE DragRect (filler: CrazyFiller; f: Display.Frame; x0, y0, x1, y1: INTEGER; VAR x2, y2: INTEGER;
  148.     VAR keysum: SET);
  149.     VAR keys: SET; x, y: INTEGER;
  150.     PROCEDURE ReplConst(x, y, w, h: INTEGER);
  151.     BEGIN
  152.         IF w < 0 THEN x := x + w; w := - w END;
  153.         IF h < 0 THEN y := y + h; h := - h END;
  154.         IF (w # 0) & (h # 0) THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END
  155.     END ReplConst;
  156.     PROCEDURE FlipRect(x0, y0, x1, y1, x2, y2: INTEGER);
  157.     BEGIN
  158.         ReplConst(x0 + 1, y1, x1 - x0 - 2, 1);
  159.         ReplConst(x1 - 1, y1, 1, y0 - y1);
  160.         ReplConst(x1 - 1, y0 - 1, x2 - x1, 1);
  161.         ReplConst(x2 - 1, y2, 1, y0 - y2);
  162.         ReplConst(x0 + 1, y2, x2 - x0 - 2, 1);
  163.         ReplConst(x0, y2, 1, y1 - y2)
  164.     END FlipRect;
  165. BEGIN
  166.     keys := keysum;
  167.     FlipRect(x0, y0, x0 + 1, y0 - 1, x1, y1); (* draw initial rectangle *)
  168.     WHILE keys # {} DO
  169.         Input.Mouse(keys, x, y);
  170.         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y);
  171.         keysum := keysum + keys;
  172.         x2 := Min(Max(x, f.X), f.X + f.W); (* confine x2 to frame f *)
  173.         y2 := Min(Max(y, f.Y), f.Y + f.H); (* confine y2 to frame f *)
  174.         IF y2 < SHORT(ENTIER(y0 - ABS(x2 - x0) * filler.vwr.H / filler.vwr.W + 0.5)) THEN
  175.             y2 := SHORT(ENTIER(y0 - ABS(x2 - x0) * filler.vwr.H / filler.vwr.W + 0.5))
  176.         ELSIF y2 > SHORT(ENTIER(y0 + ABS(x2 - x0) * filler.vwr.H / filler.vwr.W + 0.5)) THEN
  177.             y2 := SHORT(ENTIER(y0 + ABS(x2 - x0) * filler.vwr.H / filler.vwr.W + 0.5))
  178.         END;
  179.         IF (x2 # x1) OR (y2 # y1) THEN
  180.             FlipRect(x0, y0, x1, y1, x2, y2);
  181.             x1 := x2; y1 := y2
  182.         END
  183.     END;
  184.     FlipRect(x0, y0, x0 + 1, y0 - 1, x1, y1) (* erase spanned rectangle *)
  185. END DragRect;
  186. PROCEDURE InitDrawer* (VAR drawer: DrawerDesc; W, H: INTEGER; 
  187.     filler: CrazyFiller; draw: Oberon.Handler);
  188. BEGIN
  189.     drawer.handle := draw; drawer.safe := FALSE;
  190.     drawer.filler := filler;
  191.     drawer.dx := (drawer.filler.xMax - drawer.filler.xMin) / W;
  192.     drawer.dy := (drawer.filler.yMax - drawer.filler.yMin) / H;
  193. END InitDrawer;
  194. PROCEDURE InitFiller (filler: CrazyFiller; vwr: Viewers.Viewer);
  195. BEGIN
  196.     filler.xMin := -2.25; filler.xMax := 0.75; 
  197.     filler.yMin := -1.125; filler.yMax := 1.125;
  198.     filler.vwr := vwr;
  199. END InitFiller;
  200. PROCEDURE InstallCustomHandler* (h: Display.Handler);
  201.     VAR m: Viewers.ViewerMsg;
  202. BEGIN
  203.     IF h = fillerHandler THEN RETURN END;
  204.     m.id := Viewers.restore;
  205.     IF userFiller.regions # NIL THEN userFiller.regions := NIL; Oberon.Remove(userFiller.drawer) END;
  206.     userFiller.vwr.handle := h; userFiller.vwr.handle(userFiller.vwr, m);
  207.     IF systemFiller.regions # NIL THEN systemFiller.regions := NIL; Oberon.Remove(systemFiller.drawer) END;
  208.     systemFiller.vwr.handle := h; systemFiller.vwr.handle(systemFiller.vwr, m)
  209. END InstallCustomHandler;
  210. PROCEDURE DefaultHandler* (f: Display.Frame; VAR m: Display.FrameMsg);
  211. BEGIN
  212.     WITH f: Viewers.Viewer DO
  213.         IF m IS Oberon.InputMsg THEN
  214.             WITH m: Oberon.InputMsg DO
  215.                 IF m.id=Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, m.X, m.Y) END
  216.             END
  217.         ELSIF m IS Oberon.ControlMsg THEN
  218.             WITH m: Oberon.ControlMsg DO
  219.                 IF m.id=Oberon.mark THEN Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, m.X, m.Y) END
  220.             END
  221.         ELSIF m IS Viewers.ViewerMsg THEN
  222.             WITH m: Viewers.ViewerMsg DO
  223.                 IF (m.id=Viewers.restore) & (f.W > 0) & (f.H > 0) THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  224.                     Display.ReplConst(Display.black, f.X, f.Y, f.W, f.H, Display.replace)
  225.                 ELSIF (m.id=Viewers.modify) & (m.Y < f.Y) THEN Oberon.RemoveMarks(f.X, m.Y, f.W, f.Y-m.Y);
  226.                     Display.ReplConst(Display.black, f.X, m.Y, f.W, f.Y-m.Y, Display.replace)
  227.                 END
  228.             END
  229.         END
  230. END DefaultHandler;
  231. PROCEDURE CrazyHandler* (f: Display.Frame; VAR m: Display.FrameMsg);
  232.     VAR drawer: Drawer; x, y: INTEGER; filler, oldFiller: CrazyFiller; redrawMsg: Viewers.ViewerMsg;
  233.     PROCEDURE Redraw(y, h: INTEGER);
  234.         VAR region: Region;
  235.     BEGIN
  236.         IF filler.regions # NIL THEN filler.regions := NIL; Oberon.Remove(filler.drawer) END;
  237.         Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  238.         NEW(drawer); InitDrawer(drawer^, f.W, h, filler, DrawMandelbrodt);
  239.         filler.drawer := drawer;
  240.         NEW(region); region.x := f.X; region.y := y; region.w := f.W; region.h := h;
  241.         filler.regions := region;
  242.         Display.ReplConst(Display.black, f.X, y, f.W, h, Display.replace);
  243.         Oberon.Install(drawer)
  244.     END Redraw;
  245. BEGIN
  246.     WITH f: Viewers.Viewer DO
  247.         WITH m: Viewers.ViewerMsg DO
  248.             IF f.X = 0 THEN filler := userFiller ELSE filler := systemFiller END;
  249.             IF m.id = Viewers.restore THEN
  250.                 IF (f.W > 0) & (f.H > 0) THEN Redraw(f.Y, f.H)
  251.                 ELSE IF filler.regions # NIL THEN filler.regions := NIL; Oberon.Remove(filler.drawer) END
  252.                 END 
  253.             ELSIF m.id = Viewers.modify THEN Redraw(m.Y, m.H)
  254.             ELSIF m.id = Viewers.suspend THEN
  255.                 IF filler.regions # NIL THEN filler.regions := NIL; Oberon.Remove(filler.drawer) END
  256.             END
  257.         | m: Oberon.InputMsg DO
  258.             IF m.id = Oberon.track THEN (* mouse event *)
  259.                 Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, m.X, m.Y);
  260.                 IF ML IN m.keys THEN
  261.                     IF m.X < userFiller.vwr.X + userFiller.vwr.W THEN (* click in user filler *)
  262.                         filler := userFiller
  263.                     ELSE
  264.                         filler := systemFiller
  265.                     END;
  266.                     DragRect(filler, f, m.X, m.Y, m.X + 2, m.Y - 2, x, y, m.keys); (* m.X, m.Y is the upper
  267.                         left corner; x, y is the lower right corner *)
  268.                     IF m.keys # {ML, MM, MR} THEN
  269.                         NEW(oldFiller); oldFiller^ := filler^;
  270.                         filler.yMin := oldFiller.yMin + (oldFiller.yMax - oldFiller.yMin) / oldFiller.vwr.H * (Min(y, m.Y) - oldFiller.vwr.Y);
  271.                         filler.yMax := oldFiller.yMin + (oldFiller.yMax - oldFiller.yMin) / oldFiller.vwr.H * (Max(y, m.Y) - oldFiller.vwr.Y);
  272.                         filler.xMin := oldFiller.xMin + (oldFiller.xMax - oldFiller.xMin) / oldFiller.vwr.W * (Min(x, m.X) - oldFiller.vwr.X);
  273.                         filler.xMax := oldFiller.xMin + (oldFiller.xMax - oldFiller.xMin) / oldFiller.vwr.W * (Max(x, m.X) - oldFiller.vwr.X);
  274.                         redrawMsg.id := Viewers.restore;
  275.                         filler.vwr.handle(filler.vwr, redrawMsg);
  276.                     END
  277.                 END
  278.             ELSE DefaultHandler(f, m)
  279.             END
  280.         | m: Oberon.ControlMsg DO
  281.             IF m.id = Oberon.neutralize THEN
  282.                 userFiller.xMin := -2.25; userFiller.xMax := 0.75; 
  283.                 userFiller.yMin := -1.125; userFiller.yMax := 1.125;
  284.                 systemFiller.xMin := -2.25; systemFiller.xMax := 0.75; 
  285.                 systemFiller.yMin := -1.125; systemFiller.yMax := 1.125;
  286.                 redrawMsg.id := Viewers.restore;
  287.                 userFiller.vwr.handle(userFiller.vwr, redrawMsg);
  288.                 systemFiller.vwr.handle(systemFiller.vwr, redrawMsg)
  289.             ELSE DefaultHandler(f, m)
  290.             END
  291.         ELSE DefaultHandler(f, m)
  292.         END
  293. END CrazyHandler;
  294. PROCEDURE InstallDefault*;
  295.     BEGIN InstallCustomHandler(DefaultHandler) END InstallDefault;
  296. PROCEDURE InstallCrazy*;
  297.     BEGIN InstallCustomHandler(CrazyHandler) END InstallCrazy;
  298. PROCEDURE SetMaxIter*;
  299. BEGIN
  300.     In.Open; In.Int(maxIter)
  301. END SetMaxIter;
  302. PROCEDURE SetRegsPerCycle*;
  303. BEGIN
  304.     In.Open; In.Int(regsPerCycle)
  305. END SetRegsPerCycle;
  306. PROCEDURE ShowParams*;
  307. BEGIN
  308.     IF (userFiller.vwr # NIL) & (userFiller.vwr.H > 0) THEN
  309.         Out.Ln; Out.String("User filler:");
  310.         Out.Ln; Out.String("  Range:");
  311.         Out.Ln; Out.String("    xMin = "); Out.LongReal(userFiller.xMin, 20); 
  312.         Out.String(", xMax = "); Out.LongReal(userFiller.xMax, 20);
  313.         Out.Ln; Out.String("    yMin = "); Out.LongReal(userFiller.yMin, 20); 
  314.         Out.String(", yMax = "); Out.LongReal(userFiller.yMax, 20);
  315.         Out.Ln; Out.String("  Height: "); Out.Int(userFiller.vwr.H, 0);
  316.         Out.Ln; Out.String("  Width: "); Out.Int(userFiller.vwr.W, 0);
  317.         Out.Ln; Out.String("  Iterations: "); Out.Int(maxIter, 0);
  318.         Out.Ln; Out.String("  Bound: "); Out.Int(bound, 0);
  319.         Out.Ln; Out.String("  Rectangles per cycle: "); Out.Int(regsPerCycle, 0)
  320.     END;
  321.     IF (systemFiller.vwr # NIL) & (systemFiller.vwr.H > 0) THEN
  322.         Out.Ln; Out.String("System filler:");
  323.         Out.Ln; Out.String("  Range:");
  324.         Out.Ln; Out.String("    xMin = "); Out.LongReal(systemFiller.xMin, 20); 
  325.         Out.String(", xMax = "); Out.LongReal(systemFiller.xMax, 20);
  326.         Out.Ln; Out.String("    yMin = "); Out.LongReal(systemFiller.yMin, 20); 
  327.         Out.String(", yMax = "); Out.LongReal(systemFiller.yMax, 20);
  328.         Out.Ln; Out.String("  Height: "); Out.Int(systemFiller.vwr.H, 0);
  329.         Out.Ln; Out.String("  Width: "); Out.Int(systemFiller.vwr.W, 0);
  330.         Out.Ln; Out.String("  Iterations: "); Out.Int(maxIter, 0);
  331.         Out.Ln; Out.String("  Bound: "); Out.Int(bound, 0);
  332.         Out.Ln; Out.String("  Rectangles per cycle: "); Out.Int(regsPerCycle, 0)
  333. END ShowParams;
  334. PROCEDURE Init;
  335.     VAR cur: Viewers.Viewer;    
  336. BEGIN
  337.     fillerHandler := NIL; maxIter := 100; regsPerCycle := 20;
  338.     NEW(userFiller); NEW(systemFiller); 
  339.     cur := Viewers.This(0, 0); WHILE cur.state # filler DO cur := Viewers.Next(cur) END;
  340.     InitFiller(userFiller, cur);
  341.     cur := Viewers.This(cur.W, 0); WHILE cur.state # filler DO cur := Viewers.Next(cur) END;
  342.     InitFiller(systemFiller, cur)
  343. END Init;
  344. BEGIN
  345.     Init
  346. END CrazyFiller.InstallCrazy    CrazyFiller.InstallDefault    CrazyFiller.ShowParams
  347. CrazyFiller.SetMaxIter 30
  348.